home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / UPDOIMPL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-30  |  5.6 KB  |  221 lines

  1. unit UpDoImpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelLib, ComCtrls;
  8.  
  9. type
  10.   TUpDownX = class(TActiveXControl, IUpDownX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TUpDown;
  14.     FEvents: IUpDownXEvents;
  15.     procedure ChangingEvent(Sender: TObject; var AllowChange: Boolean);
  16.     procedure ClickEvent(Sender: TObject; Button: TUDBtnType);
  17.   protected
  18.     { Protected declarations }
  19.     procedure InitializeControl; override;
  20.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  21.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  22.     function Get_AlignButton: TxUDAlignButton; safecall;
  23.     function Get_ArrowKeys: WordBool; safecall;
  24.     function Get_Cursor: Smallint; safecall;
  25.     function Get_Enabled: WordBool; safecall;
  26.     function Get_Increment: Integer; safecall;
  27.     function Get_Max: Smallint; safecall;
  28.     function Get_Min: Smallint; safecall;
  29.     function Get_Orientation: TxUDOrientation; safecall;
  30.     function Get_Position: Smallint; safecall;
  31.     function Get_Thousands: WordBool; safecall;
  32.     function Get_Visible: WordBool; safecall;
  33.     function Get_Wrap: WordBool; safecall;
  34.     procedure AboutBox; safecall;
  35.     procedure Set_AlignButton(Value: TxUDAlignButton); safecall;
  36.     procedure Set_ArrowKeys(Value: WordBool); safecall;
  37.     procedure Set_Cursor(Value: Smallint); safecall;
  38.     procedure Set_Enabled(Value: WordBool); safecall;
  39.     procedure Set_Increment(Value: Integer); safecall;
  40.     procedure Set_Max(Value: Smallint); safecall;
  41.     procedure Set_Min(Value: Smallint); safecall;
  42.     procedure Set_Orientation(Value: TxUDOrientation); safecall;
  43.     procedure Set_Position(Value: Smallint); safecall;
  44.     procedure Set_Thousands(Value: WordBool); safecall;
  45.     procedure Set_Visible(Value: WordBool); safecall;
  46.     procedure Set_Wrap(Value: WordBool); safecall;
  47.   end;
  48.  
  49. implementation
  50. uses UpDownPg;
  51. { TUpDownX }
  52.  
  53. procedure TUpDownX.InitializeControl;
  54. begin
  55.   FDelphiControl := Control as TUpDown;
  56.   FDelphiControl.OnChanging := ChangingEvent;
  57.   FDelphiControl.OnClick := ClickEvent;
  58. end;
  59.  
  60. procedure TUpDownX.EventSinkChanged(const EventSink: IUnknown);
  61. begin
  62.   FEvents := EventSink as IUpDownXEvents;
  63. end;
  64.  
  65. procedure TUpDownX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  66. begin
  67.   { Define property pages here.  Property pages are defined by calling
  68.     DefinePropertyPage with the class id of the page.  For example,
  69.       DefinePropertyPage(Class_UpDownXPage); }
  70. end;
  71.  
  72. function TUpDownX.Get_AlignButton: TxUDAlignButton;
  73. begin
  74.   Result := Ord(FDelphiControl.AlignButton);
  75. end;
  76.  
  77. function TUpDownX.Get_ArrowKeys: WordBool;
  78. begin
  79.   Result := FDelphiControl.ArrowKeys;
  80. end;
  81.  
  82. function TUpDownX.Get_Cursor: Smallint;
  83. begin
  84.   Result := Smallint(FDelphiControl.Cursor);
  85. end;
  86.  
  87. function TUpDownX.Get_Enabled: WordBool;
  88. begin
  89.   Result := FDelphiControl.Enabled;
  90. end;
  91.  
  92. function TUpDownX.Get_Increment: Integer;
  93. begin
  94.   Result := FDelphiControl.Increment;
  95. end;
  96.  
  97. function TUpDownX.Get_Max: Smallint;
  98. begin
  99.   Result := FDelphiControl.Max;
  100. end;
  101.  
  102. function TUpDownX.Get_Min: Smallint;
  103. begin
  104.   Result := FDelphiControl.Min;
  105. end;
  106.  
  107. function TUpDownX.Get_Orientation: TxUDOrientation;
  108. begin
  109.   Result := Ord(FDelphiControl.Orientation);
  110. end;
  111.  
  112. function TUpDownX.Get_Position: Smallint;
  113. begin
  114.   Result := FDelphiControl.Position;
  115. end;
  116.  
  117. function TUpDownX.Get_Thousands: WordBool;
  118. begin
  119.   Result := FDelphiControl.Thousands;
  120. end;
  121.  
  122. function TUpDownX.Get_Visible: WordBool;
  123. begin
  124.   Result := FDelphiControl.Visible;
  125. end;
  126.  
  127. function TUpDownX.Get_Wrap: WordBool;
  128. begin
  129.   Result := FDelphiControl.Wrap;
  130. end;
  131.  
  132. procedure TUpDownX.AboutBox;
  133. begin
  134.   ShowUpDownXAbout;
  135. end;
  136.  
  137. procedure TUpDownX.Set_AlignButton(Value: TxUDAlignButton);
  138. begin
  139.   FDelphiControl.AlignButton := TUDAlignButton(Value);
  140. end;
  141.  
  142. procedure TUpDownX.Set_ArrowKeys(Value: WordBool);
  143. begin
  144.   FDelphiControl.ArrowKeys := Value;
  145. end;
  146.  
  147. procedure TUpDownX.Set_Cursor(Value: Smallint);
  148. begin
  149.   FDelphiControl.Cursor := TCursor(Value);
  150. end;
  151.  
  152. procedure TUpDownX.Set_Enabled(Value: WordBool);
  153. begin
  154.   FDelphiControl.Enabled := Value;
  155. end;
  156.  
  157. procedure TUpDownX.Set_Increment(Value: Integer);
  158. begin
  159.   FDelphiControl.Increment := Value;
  160. end;
  161.  
  162. procedure TUpDownX.Set_Max(Value: Smallint);
  163. begin
  164.   FDelphiControl.Max := Value;
  165. end;
  166.  
  167. procedure TUpDownX.Set_Min(Value: Smallint);
  168. begin
  169.   FDelphiControl.Min := Value;
  170. end;
  171.  
  172. procedure TUpDownX.Set_Orientation(Value: TxUDOrientation);
  173. begin
  174.   FDelphiControl.Orientation := TUDOrientation(Value);
  175. end;
  176.  
  177. procedure TUpDownX.Set_Position(Value: Smallint);
  178. begin
  179.   FDelphiControl.Position := Value;
  180. end;
  181.  
  182. procedure TUpDownX.Set_Thousands(Value: WordBool);
  183. begin
  184.   FDelphiControl.Thousands := Value;
  185. end;
  186.  
  187. procedure TUpDownX.Set_Visible(Value: WordBool);
  188. begin
  189.   FDelphiControl.Visible := Value;
  190. end;
  191.  
  192. procedure TUpDownX.Set_Wrap(Value: WordBool);
  193. begin
  194.   FDelphiControl.Wrap := Value;
  195. end;
  196.  
  197. procedure TUpDownX.ChangingEvent(Sender: TObject;
  198.   var AllowChange: Boolean);
  199. var
  200.   TempAllowChange: WordBool;
  201. begin
  202.   TempAllowChange := WordBool(AllowChange);
  203.   if FEvents <> nil then FEvents.OnChanging(TempAllowChange);
  204.   AllowChange := Boolean(TempAllowChange);
  205. end;
  206.  
  207. procedure TUpDownX.ClickEvent(Sender: TObject; Button: TUDBtnType);
  208. begin
  209.   if FEvents <> nil then FEvents.OnClick(TxUDBtnType(Button));
  210. end;
  211.  
  212. initialization
  213.   TActiveXControlFactory.Create(
  214.     ComServer,
  215.     TUpDownX,
  216.     TUpDown,
  217.     Class_UpDownX,
  218.     29,
  219.     '{5A5659E9-7975-11D0-BE02-00A024D1875C}');
  220. end.
  221.